$title  Fiscal Federalism with Electoral Competition

$if not set esub $set esub 1

$eolcom !

set     instr   Instruments /tax, transfer/

set     r       Regions (states) /1*3/

set     eq      Equilibria /
           ref,            ! Reference equilibrium
           tl1*tl3,        ! Perturbations to determine labor tax rates
           tk1*tk3,        ! Perturbations to determine capital tax rates
           trn1*trn3       ! Perturbations to determine transfers
 /,
        ref(eq) /ref/;

parameter       delta /0.0001/;

parameter       tleq(r), tkeq(r), trneq(r),  deltatl(r,eq), deltatk(r,eq), deltatrn(r,eq), n(r);

tleq(r)  = ord(r);
tkeq(r)  = card(r) + ord(r);
trneq(r) = 2*card(r) + ord(r);
n(r) = 1;
deltatl(r,eq)  = delta$(ord(eq)-1 = tleq(r));
deltatk(r,eq)  = delta$(ord(eq)-1 = tkeq(r));
deltatrn(r,eq) = delta$(ord(eq)-1 = trneq(r));
display tleq, tkeq,trneq, deltatl, deltatk, deltatrn;

parameter
        y0(r,eq)   Base year regional output [[y0:r*eq]]
        l0(r,eq)   Employment (net wage payments) [[l0:r*eq]]
        ls0(r,eq)  Leisure [[ls0:r*eq]]
        c0(r,eq)   Consumption demand [[c0:r*eq]]
        g0(r,eq)   Public demand [[g0:r*eq]]
        r0(r,eq)   Resource return [[r0:r*eq]]
        k0(r,eq)   Capital return [[k0:r*eq]]
        pl0(r,eq)  Power of wage [[pl0:r*eq]]
        pk0(r,eq)  Power of rental rate [[pk0:r*eq]]
        u0(r,eq)   Aggregate expenditure [[u0:r*eq]]
        t0(r,eq)   Tax revenue transfer [[t0:r*eq]];

y0(r,eq) = 1.2;
l0(r,eq) = 0.4;
ls0(r,eq) = 0.3;
c0(r,eq) = 1;
g0(r,eq) = 0.2;
r0(r,eq) = 0.2;
k0(r,eq) = 0.4;

pl0(r,eq) = 1.2;
pk0(r,eq) = 1.2;

u0(r,eq)= g0(r,eq) + ls0(r,eq) + c0(r,eq);
t0(r,eq) = 0.1;

variable        theta(r);
theta.l(r) = 1;

$if not exist fisc-fed.har $include gdxtohar

$ontext

$model:madden

$sectors:
        y(r,eq)         ! Production
        c(r,eq)         ! Consumption

$commodities:
        p(eq)           ! Price index
        pc(r,eq)        ! Consumption price
        pg(r,eq)        ! Public goods
        pl(r,eq)        ! Wage rate
        pr(r,eq)        ! Resource rent
        rk(eq)          ! Capital return
        pgrant(eq)      ! Grant return

$consumers:
        ra(r,eq)        ! Representative agent
        state(r,eq)     ! State government
        fed(eq)

$auxiliary:
        s(eq)           ! Political support
        trn(r,eq)       ! Federal transfer to state r
        tl(r,eq)        ! State labor tax
        tk(r,eq)        ! State capital tax
        tf(eq)          ! Federal tax rate
        g(r,eq)         ! Level of public provision

$prod:y(r,eq)   s:1
        o:p(eq)         q:y0(r,eq)
        i:pl(r,eq)      q:l0(r,eq)  p:pl0(r,eq)
+                   a:state(r,eq) n:tl(r,eq) a:fed(eq)  n:tf(eq)
        i:pr(r,eq)      q:r0(r,eq)  p:pk0(r,eq)
+                   a:state(r,eq) n:tk(r,eq) a:fed(eq)  n:tf(eq)
        i:rk(eq)        q:k0(r,eq)  p:pk0(r,eq)
+                   a:state(r,eq) n:tk(r,eq) a:fed(eq)  n:tf(eq)

$report:
        v:dk(r,eq)      i:rk(eq)        prod:y(r,eq)

$prod:c(r,eq)   s:0.5  cl:1
        o:pc(r,eq)      q:u0(r,eq)
        i:pg(r,eq)      q:g0(r,eq)
        i:pl(r,eq)      q:ls0(r,eq)        cl:
        i:p(eq)         q:c0(r,eq)         cl:

$demand:ra(r,eq)
        e:pl(r,eq)      q:(n(r)*(ls0(r,eq)+l0(r,eq)))
        e:rk(eq)        q:k0(r,eq)
        e:pr(r,eq)      q:r0(r,eq)
        e:pg(r,eq)      q:(n(r)*g0(r,eq))          r:g(r,eq)
        d:pc(r,eq)

$demand:state(r,eq)
        e:pgrant(eq)    q:t0(r,eq)         r:trn(r,eq)
        d:p(eq)

$constraint:g(r,eq)
        g(r,eq) * g0(r,eq) * p(eq) =e= state(r,eq);

* [03/06/04] Ken thinks that this is not a valid MGE file since 
*  pgrant violates Tom's "new" rule that every price in a d: line
*  in a $demand block should appear in exactly one o: line in a $prod: block
$demand:fed(eq)
        d:pgrant(eq)

$constraint:s(eq)
        s(eq) =e= 1000 * sum(r, n(r) * theta(r) * log(c(r,eq)/n(r)));

$constraint:tf(eq)
        pgrant(eq) =e= p(eq);

$constraint:tl(r,eq)
        (tl(r,eq) - tl(r,"ref") - deltatl(r,eq) )$(not ref(eq)) +
        (c(r,eq+tleq(r)) - c(r,eq)              )$ref(eq) =e= 0;

$constraint:tk(r,eq)
        (tk(r,eq) - tk(r,"ref") - deltatk(r,eq) )$(not ref(eq)) +
        (c(r,eq+tkeq(r)) - c(r,eq)              )$ref(eq) =e= 0;

*       First order conditions for transfers:

$constraint:trn(r,eq)
        (trn(r,eq) - trn(r,"ref") - deltatrn(r,eq) )$(not ref(eq))+
        (s(eq+trneq(r)) - s(eq)                    )$ref(eq) =e= 0;

$offtext
$sysinclude mpsgeset madden

tf.l(eq) = 0.1;
tl.l(r,eq) = 0.1;
tk.l(r,eq) = 0.1;
trn.l(r,eq) = 1;

g.l(r,eq) = 1;

tf.fx("ref") = 0.1;
tl.fx(r,"ref") = 0.1;
tk.fx(r,"ref") = 0.1;
trn.fx(r,"ref") = 1;
s.lo(eq) = -inf;

p.fx(eq) = 1;

theta.fx(r) = 1;

madden.iterlim = 0;
$include madden.gen
solve madden using mcp;

madden.iterlim = 100000;
$include madden.gen
solve madden using mcp;

equation politics;

alias (r,rr);

politics(rr)..  s("ref") =e= 1000 * sum((r,eq)$deltatrn(rr,eq), theta(r) * log(c(r,eq)));

model calib /politics.theta/;

theta.lo(r) = -inf;
theta.up(r) = +inf;
theta.fx(r)$(ord(r) eq 1) = 1;
s.fx(eq)= s.l(eq);
c.fx(r,eq) = c.l(r,eq);
solve calib using mcp;

c.lo(r,eq) = 0;
s.lo(eq)= -inf;
s.up(eq)= inf;
c.up(r,eq) = inf;
theta.fx(r) = theta.l(r);

tf.lo(eq) = 0;
tf.up(eq) = +inf;
trn.lo(r,eq) = -inf;
trn.up(r,"ref") = +inf;

$include madden.gen
solve madden using mcp;

tl.lo(r,"ref") = 0;
tk.lo(r,"ref") = 0;
tl.up(r,"ref") = inf;
tk.up(r,"ref") = inf;
$include madden.gen
solve madden using mcp;

parameter       results         Percentage changes in key variables;
results(r,"g") = 100 * (g.l(r,"ref")-1);
results(r,"trn") = 100 * (trn.l(r,"ref")-1);
results(r,"k") = 100 * (dk.l(r,"ref")/k0(r,"ref")-1);
results(r,"tk") = 100 * (tk.l(r,"ref")-0.1);
results(r,"tl") = 100 * (tl.l(r,"ref")-0.1);
results(r,"tf") = 100 * (tf.l("ref")-0.1);

n(r) = 1 + 0.1 * (ord(r)-1);

parameter g_, trn_, dk_, tk_, tl_, tf_;

g_(r) = g.l(r,"ref");
trn_(r) = trn.l(r,"ref");
dk_(r) = dk.l(r,"ref");
tk_(r) = tk.l(r,"ref");
tl_(r) = tl.l(r,"ref");
tf_ = tf.l("ref");

$include madden.gen
solve madden using mcp;

display results;

results(r,"g") = 100 * (g.l(r,"ref")/g_(r)-1);
results(r,"trn") = 100 * (trn.l(r,"ref")/(n(r)*trn_(r))-1);
results(r,"k") = 100 * (dk.l(r,"ref")/dk_(r)-1);
results(r,"tk") = 100 * (tk.l(r,"ref")-tk_(r));
results(r,"tl") = 100 * (tl.l(r,"ref")-tl_(r));
results(r,"tf") = 100 * (tf.l("ref")-tf_);
display results;
